COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Routines to plot performance of the implementations
C00006 00003	 Routines to plot performance of the implementations (hardcopy)
C00010 00004	 For each benchmark:
C00017 00005	(declare (special *logp* *rawp*))
C00022 00006	 This is for hardcopy:
C00024 ENDMK
C⊗;
;;; Routines to plot performance of the implementations

(eval-when (load) 
	   (fasload ddmid fas dsk (sys rod)))
(declare (special *chan* *points* *best* *scale*)
	 (setq defmacro-for-compiling ())
	 (mapex t)
	 (*expr ddinit screen erase line dpyup gddchn rddchn))

;;; *chan* is a global variable containing the channel number

(setq *scale* 1.0)

;;; Places a vertical tick yeps high at (x,y)

(defun v-tick (x y yeps)
       (let ((half-yeps (//$ yeps 2.0)))
	    (line x (-$ y half-yeps) x (+$ y half-yeps))))

;;; Places a horizontal tick xeps high at (x,y)

(defun h-tick (x y xeps)
       (let ((half-xeps (//$ xeps 2.0)))
	    (line (-$ x half-xeps) y (+$ x half-xeps) y)))

;;; This takes a set of points of the form:
;;; (...(y1...yn)...) = L
;;; sets up the co-ordinates for the graph. If L is n long, then
;;; the x-axis goes from 0 to n. The y-axis goes from the minimum of yi to the
;;; maximum of yi.

(defun graph (points)
       (declare (flonum fhx fhy xeps yeps))
       (cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((fhx (+$ 1.0 (float (length points))))
		      (ymin (car (car points))) 
		      (ymax (car (car points)))(fhy 0.0)
		      (xeps 0.0) (yeps 0.0))
		     (do ((l points (cdr l)))
			 ((null l))
			 (do ((p (car l) (cdr p)))
			     ((null p))
			     (cond ((lessp (car p) ymin)
				    (setq ymin (car p)))
				   ((greaterp (car p) ymax)
				    (setq ymax (car p))))))
		     (setq fhy (+$ 1.0 (*$ 1.1 (-$ ymax ymin))))
		     (setq xeps (//$ fhx 100.0))
		     (setq yeps (//$ fhy 100.0))
		     (setq *chan* (gddchn -1))
		     (ddinit)
		     (screen 0.5 0.5 (*$ 1.2 (*$ (float *scale*) fhx))
			     (*$ 1.2 (*$ (float *scale*) fhy)))
		     (erase *chan*)
		     (line 1.0 1.0 1.0 fhy)
		     (line 1.0 1.0 fhx 1.0)
		     (let ((ox 1.0)
			   (oy 0.0))
		     (do ((l points (cdr l))
			  (n 2 (1+ n)))
			 ((null l)
			  (dpyup *chan*))
			 (setq ox (float n))
			 (setq oy (-$ (+$ 1.1 (car (car l))) ymin))
			 (h-tick ox oy xeps)
			 (do ((p (cdar l) (cdr p)) 
			      (nx (float n))
			      (ny 0.0))
			     ((null p)
			      (line ox oy nx ny)
			      (h-tick nx ny xeps))
			     (h-tick nx ny xeps)
			     (setq ny (-$ (+$ 1.1 (car p)) ymin))
			     (line ox oy nx ny)
			     (setq ox nx oy ny))))))))

(defun init ()
       (erase *chan*)
       (rddchn *chan*))

;;; Routines to plot performance of the implementations (hardcopy)

(eval-when (load) 
	   (fasload god fas dsk (sys ml)))
(declare (special *chan* *points* *best* *scale*)
	 (setq defmacro-for-compiling ())
	 (mapex t)
	 (*expr ddinit-g screen-g erase-g line-g dpyup-g gddchn-g rddchn-g))

;;; *chan* is a global variable containing the channel number

(setq *scale* 1.0)

;;; Places a vertical tick yeps high at (x,y)

(defun v-tick-g (x y yeps)
       (let ((half-yeps (//$ yeps 2.0)))
	    (line-g x (-$ y half-yeps) x (+$ y half-yeps))))

;;; Places a horizontal tick xeps high at (x,y)

(defun h-tick-g (x y xeps)
       (let ((half-xeps (//$ xeps 2.0)))
	    (line-g (-$ x half-xeps) y (+$ x half-xeps) y)))

;;; This takes a set of points of the form:
;;; (...(y1...yn)...) = L
;;; sets up the co-ordinates for the graph. If L is n long, then
;;; the x-axis goes from 0 to n. The y-axis goes from the minimum of yi to the
;;; maximum of yi.

(defun graph-g (points)
       (declare (flonum fhx fhy xeps yeps))
       (cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((fhx (+$ 1.0 (float (length points))))
		      (ymin (car (car points))) 
		      (ymax (car (car points)))(fhy 0.0)
		      (xeps 0.0) (yeps 0.0))
		     (do ((l points (cdr l)))
			 ((null l))
			 (do ((p (car l) (cdr p)))
			     ((null p))
			     (cond ((lessp (car p) ymin)
				    (setq ymin (car p)))
				   ((greaterp (car p) ymax)
				    (setq ymax (car p))))))
		     (setq fhy (+$ 1.0 (*$ 1.1 (-$ ymax ymin))))
		     (setq xeps (//$ fhx 100.0))
		     (setq yeps (//$ fhy 100.0))
		     (setq *chan* -1)
		     (ddinit-g)
		     (screen-g 0.5 0.5 (*$ 1.2 (*$ (float *scale*) fhx))
			     (*$ 1.2 (*$ (float *scale*) fhy)))
		     (line-g 1.0 1.0 1.0 fhy)
		     (line-g 1.0 1.0 fhx 1.0)
		     (let ((ox 1.0)
			   (oy 0.0))
		     (do ((l points (cdr l))
			  (n 2 (1+ n)))
			 ((null l)
			  (dpyup-g *chan*))
			 (setq ox (float n))
			 (setq oy (-$ (+$ 1.0 (car (car l))) ymin))
			 (h-tick-g ox oy xeps)
			 (do ((p (cdar l) (cdr p)) 
			      (nx (float n))
			      (ny 0.0))
			     ((null p)
			      (line-g ox oy nx ny)
			      (h-tick-g nx ny xeps))
			     (h-tick-g nx ny xeps)
			     (setq ny (-$ (+$ 1.0 (car p)) ymin))
			     (line-g ox oy nx ny)
			     (setq ox nx oy ny))))))))

;;; For each benchmark:
;;;(...(benchmark
;;;     ((blankline))
;;;     ((indent 1) "Benchmark 3" (entry (f entry)))
;;;     ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)


(declare (special *data* *benchmarks* *all-implementations* *normalize*
		  *all-implementations-flattened* *max-length*
		  *selectors* *subset-relationships* *all-benchmarks* *leave-outs*))
(declare (mapex t))

(declare (special *benchmark-info*))

(defun get-bench-data (bench impl)
       (cadr (assq impl (cdr (assoc bench *data*)))))

(declare (special *logp* *rawp*))

(setq *logp* () *rawp* ())

(defun graph-impls-real (implementations)
       (graph-impls implementations 'real))

(defun graph-impls-cpu (implementations)
       (graph-impls implementations 'cpu))

(defun graph-impls (implementations type)
 (let ((best-alist
	(or *logp* *rawp*
	    (mapcar #'(lambda (bench)
			      `(,(car bench) 
				,(find-best (car bench) (caddr bench)
					    (mapcar #'car *all-implementations-flattened*)
					    type))) 
		*all-benchmarks*))))
      (and (boundp '*chan*) (init))
      (graph
	(mapcan #'(lambda (impl)
			  (let ((info 
				 (make-a-column impl best-alist type)))
			       (cond (info (ncons info)))))
		implementations))
       *chan*))

(defun make-a-column (impl best-alist type)
       (mapcan 
	#'(lambda (bench)
		  (let ((info 
			 (funcall (caddr bench)
				  (get-bench-data 
				   (find-superset-bench (car bench)) 
				   (find-superset-impl impl))))
			(best (or *logp* *rawp* 
				  (cadr (assq (car bench) best-alist)))))
		       (caseq type
			      (real
			       (let ((entry (real-time impl info)))
				    (cond (*logp*
					   (cond ((and 
						   (numberp entry)
						   (lessp 0.0 entry))
						  (ncons (log entry)))))
					  (t 
					   (cond 
					    ((numberp entry)
					     (cond 
					      (*rawp* (ncons entry))
					      ((numberp best)
					       (ncons 
						(-$ 100.0
						    (*$ 100.0
							(//$ best (float entry)))))))))))))
			      (cpu
			       (let ((entry (cpu-time impl info)))
				    (cond 
				     (*logp*
				      (cond 
				       ((and 
					 (numberp entry)
					 (lessp 0.0 entry))
					(ncons (log entry)))))
				     (t 
				      (cond 
				       ((numberp entry)
					(cond (*rawp* (ncons entry))
					      ((numberp best)
					       (ncons 
						(-$ 100.0 (*$ 100.0
							      (//$ best (float entry)))))))))))))
				    (t ()))))
	*all-benchmarks*))

(defun find-best (bench fun impls type)
       (let ((data
	      (mapcan #'(lambda (impl)
				(let ((info 
				       (funcall fun
						(get-bench-data 
						 (find-superset-bench bench) 
						 (find-superset-impl impl)))))
				     (caseq type
					    (real
					     (let ((entry (real-time impl info)))
						  (cond ((numberp entry)
							 (ncons (float entry))))))
					    (cpu
					     (let ((entry (cpu-time impl info)))
						  (cond ((numberp entry)
							 (ncons (float entry))))))
					    (t ()))))
		      impls)))
	    (do ((data (cdr data) (cdr data))
		 (best (car data)))
		((null data) best)
		(cond ((lessp (car data) best)
		       (setq best (car data)))))))

(defun find-superset-bench (bench)
       (do ((b *subset-relationships* (cdr b)))
	   ((null b) ())
	   (cond ((memq bench (cadr (car b)))
		  (return (car (car b)))))))

(defun find-superset-impl (impl)
       (cadr (assq impl *all-implementations-flattened*)))
;;; This is for hardcopy:

(defun graph-impls-real-g (implementations)
       (graph-impls-g implementations 'real))

(defun graph-impls-cpu-g (implementations)
       (graph-impls-g implementations 'cpu))

(defun graph-impls-g (implementations type)
 (let ((best-alist
	(or *logp*
	    (mapcar #'(lambda (bench)
			      `(,(car bench) 
				,(find-best (car bench) (caddr bench)
					    (mapcar #'car *all-implementations-flattened*)
					    type))) 
		*all-benchmarks*))))
      (graph-g
	(mapcan #'(lambda (impl)
			  (let ((info 
				 (make-a-column impl best-alist type)))
			       (cond (info (ncons info)))))
		implementations))
      t))